home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / MYMUD21.ZIP / MMUD21.ZIP / SOURCE / SOURCE.ZIP / TIMER.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-21  |  5KB  |  207 lines

  1. {$I COPYRGHT.INC}
  2.  
  3. (*----------------------------------------------------------------------------*
  4.    Timer routines. Used to time the checks for online messages and
  5.    for the shutdown semaphore.
  6.  *---------------------------------------------------------------------------*)
  7. Unit Timer;
  8. Interface
  9. Uses Dos;
  10.  
  11.  
  12. Type TimeString  = String[8];
  13.      TimerObject = Object
  14.                      TimeOut   : LongInt;
  15.                      StartTime : LongInt;
  16.                      _24Hour   : Boolean;
  17.  
  18.                      Procedure SetEvent(TimeStr : TimeString);
  19.                      Function EventTime(TimeStr : TimeString):LongInt;
  20.                      Function TestTime(TimeStr : TimeString):Boolean;
  21.                      Function TimeNow:LongInt;
  22.  
  23.                      Procedure SetTimer(TenthsOfSec : LongInt);
  24.                      Function TimeUp:Boolean;
  25.                      Function SecToGo:LongInt;
  26.                      Function TimeToGo:TimeString;
  27.                     End;
  28.  
  29.      ClockObject = Object
  30.                     StartTime  : LongInt;
  31.  
  32.                     Procedure StartTimer;
  33.                     Function GiveTime:TimeString;
  34.                    End;
  35.  
  36. Implementation
  37.  
  38. Const DayTime : LongInt = 864000;
  39.  
  40. Function S(Number : LongInt;Size:Byte):String;
  41. Var HStr : String[20];
  42. Begin
  43. Str(Number:Size,HStr);
  44. S:=HStr;
  45. End;
  46.  
  47. Function Str2Nr(S : String):Word;
  48. Var Temp : Word;
  49.     Err  : Integer;
  50. Begin
  51. Val(S,Temp,Err);
  52. IF Err>0
  53.    Then Str2Nr:=0
  54.    Else Str2Nr:=Temp;
  55. End;
  56.  
  57. Function TimerObject.TestTime(TimeStr : TimeString):Boolean;
  58. Var S2 : String[2];
  59. Begin
  60. TestTime:=False;
  61. S2:=Copy(TimeStr,1,2);
  62. If Not (
  63.    (Str2Nr(S2) in [0..23]) And
  64.    (S2[1] in ['0'..'9']) And
  65.    (S2[2] in ['0'..'9'])
  66.    )
  67.    Then Exit;
  68. S2:=Copy(TimeStr,4,2);
  69. If Not (
  70.    (Str2Nr(S2) in [0..59]) And
  71.    (S2[1] in ['0'..'9']) And
  72.    (S2[2] in ['0'..'9'])
  73.    )
  74.    Then Exit;
  75. TestTime:=True;
  76. End;
  77.  
  78.  
  79.  
  80. Function TimerObject.EventTime(TimeStr : TimeString):LongInt;
  81. Var H,M,S : Word;
  82. Begin
  83. H:=Str2Nr(Copy(TimeStr,1,2));  Delete(TimeStr,1,3);
  84. M:=Str2Nr(Copy(TimeStr,1,2));  Delete(TimeStr,1,3);
  85. S:=Str2Nr(Copy(TimeStr,1,2));
  86. EventTime:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
  87. End;
  88.  
  89. Function TimerObject.TimeNow:LongInt;
  90. Var H,M,S,D : Word;
  91. Begin
  92. GetTime(H,M,S,D);
  93. TimeNow:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
  94. End;
  95.  
  96. Procedure TimerObject.SetEvent(TimeStr : TimeString);
  97. Begin
  98. TimeOut:=EventTime(TimeStr);
  99. If TimeOut=0
  100.    Then TimeOut:=DayTime;
  101. _24Hour:=(TimeOut>=DayTime);
  102. If _24Hour
  103.    Then TimeOut:=TimeOut-DayTime;
  104. End;
  105.  
  106. Procedure TimerObject.SetTimer(TenthsOfSec : LongInt);
  107. Var H,M,S,D : Word;
  108. Begin
  109. GetTime(H,M,S,D);
  110. TimeOut:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
  111. TimeOut:=TimeOut+TenthsOfSec;
  112. _24Hour:=(TimeOut>=DayTime);
  113. If _24Hour
  114.    Then TimeOut:=TimeOut-DayTime;
  115. End;
  116.  
  117.  
  118. Function TimerObject.TimeUp:Boolean;
  119. Var Test : LongInt;
  120.     H,M,S,D : Word;
  121. Begin
  122. GetTime(H,M,S,D);
  123. Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
  124. If _24Hour and (H>0)
  125.    Then Test:=Test-DayTime;
  126. TimeUp:=Test>TimeOut;
  127. End;
  128.  
  129. Function TimerObject.SecToGo:LongInt;
  130. Var Test : LongInt;
  131.     H,M,S,D : Word;
  132. Begin
  133. GetTime(H,M,S,D);
  134. Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
  135. If _24Hour And (H>0)
  136.    Then Test:=Test-DayTime;
  137. SecToGo:=(TimeOut-Test) Div 10;
  138. End;
  139.  
  140. Function TimerObject.TimeToGo:TimeString;
  141. Var Test      : LongInt;
  142.     HStr      : TimeString;
  143.     H,M,Sec,D : Word;
  144.     Step      : Byte;
  145. Begin
  146. GetTime(H,M,Sec,D);
  147. Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(Sec)*10)+(LongInt(D) Div 10);
  148. If _24Hour And (H>0)
  149.    Then Test:=Test-DayTime;
  150. Test:=(TimeOut-Test) Div 10;
  151.  
  152. H:=Test Div 3600;
  153. Test:=Test mod 3600;
  154. M:=Test Div 60;
  155. Test :=Test Mod 60;
  156. Sec:=Test;
  157.  
  158. HStr:= S(H,2)+ ':'+
  159.        S(M,2)+ ':'+
  160.        S(Sec,2);
  161. For Step:=1 To Length(HStr) Do
  162. If HStr[Step]=' '
  163.    Then HStr[Step]:='0';
  164.  
  165. TimeToGo:=HStr;
  166. End;
  167.  
  168.  
  169.  
  170.  
  171. Procedure ClockObject.StartTimer;
  172. Var H,M,S,D : Word;
  173. Begin
  174. GetTime(H,M,S,D);
  175. StartTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(S));
  176. End;
  177.  
  178. Function ClockObject.GiveTime:TimeString;
  179. Var  CurrTime  : Longint;
  180.      HStr      : TimeString;
  181.      Step      : Byte;
  182.      H,M,Sec,D : Word;
  183. Begin
  184. GetTime(H,M,Sec,D);
  185. CurrTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(Sec));
  186. CurrTime:=CurrTime-StartTime;
  187. If CurrTime<0
  188.    Then Inc(CurrTime,(DayTime div 10));
  189.  
  190. H:=CurrTime Div 3600;
  191. CurrTime:=CurrTime mod 3600;
  192. M:=CurrTime Div 60;
  193. CurrTime:=CurrTime Mod 60;
  194. Sec:=CurrTime;
  195.  
  196. HStr:=S(H,2)+':'+S(M,2)+':'+S(Sec,2);
  197. For Step:=1 To Length(HStr) Do
  198. If HStr[Step]=' '
  199.    Then HStr[Step]:='0';
  200.  
  201. GiveTime:=HStr;
  202. End;
  203.  
  204. End.
  205.  
  206.  
  207.